home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_2 / ziptv21.zip / INTRCOMM.INC < prev    next >
Text File  |  1990-04-22  |  15KB  |  597 lines

  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * intrcomm.inc - interrupt-based communication library for PCB ProDOOR
  15.  *
  16.  *)
  17.  
  18. {$R-,S-}
  19.  
  20.  
  21. (* ------------------------------------------------------------ *)
  22. procedure control_k;
  23.    (* process cancel-output command *)
  24. begin
  25.    txque.next_in := 1;
  26.    txque.next_out := 1;          (* throw away pending output *)
  27.    txque.count := 0;             
  28.  
  29.    rxque.next_in := 1;
  30.    rxque.next_out := 1;          (* throw away pending input *)
  31.    rxque.count := 0;
  32.  
  33.    linenum := 9000;              (* cancel current function *)
  34.    pending_keys[0] := #0;
  35. end;
  36.  
  37.  
  38. (* ------------------------------------------------------------ *)
  39. procedure INTR_service_MSR;
  40.   (* modem status change interrupt *)
  41. var
  42.    c: byte;
  43. begin
  44.    c := port[ port_base+MSR ];
  45.    io_delay;
  46. end;
  47.  
  48.  
  49. (* ------------------------------------------------------------ *)
  50. procedure INTR_service_LSR;
  51.    (* line status change interrupt *)
  52. var
  53.    c: byte;
  54. begin
  55.    c := port[ port_base+LSR ];
  56.    io_delay;
  57. end;
  58.  
  59.  
  60. (* ------------------------------------------------------------ *)
  61. procedure INTR_service_transmit;
  62.    (* low-level interrupt service for transmit, call only when transmit
  63.       holding register is empty *)
  64. var
  65.    c:       char;
  66. const
  67.    recur:  boolean = false;
  68.  
  69. begin
  70.  
  71. (* prevent recursion fb/bg *)
  72.    if recur then exit;
  73.    recur := true;
  74.  
  75. (* drop out if transmitter is busy *)
  76.    if (port[ port_base+LSR ] and LSR_THRE) = 0 then
  77.    begin
  78.       io_delay;
  79.       recur := false;
  80.       exit;
  81.    end;
  82.  
  83.    io_delay;
  84.  
  85.    (* stop transmitting when queue is empty, or XOFF is active
  86.       or it is not CLEAR-to-send to modem *)
  87.  
  88.    xmit_active := (txque.count <> 0) and (not xoff_active) and
  89.                   (disable_CTS_check or ((port[port_base+MSR] and MSR_CTS)>0));
  90.  
  91.    io_delay;
  92.  
  93.    (* start next byte transmitting *)
  94.    if xmit_active then
  95.    begin
  96.       c := txque.data[txque.next_out];
  97.       if txque.next_out < sizeof(txque.data) then
  98.          inc(txque.next_out)
  99.       else
  100.          txque.next_out := 1;
  101.       dec(txque.count);
  102.  
  103.       port[ port_base+THR ] := ord(c); io_delay;
  104.    end;
  105.  
  106.    recur := false;
  107. end;
  108.  
  109.  
  110. (* ------------------------------------------------------------ *)
  111. procedure INTR_service_receive;
  112.    (* low-level interrupt service for receive data,
  113.       call only when receive data is ready *)
  114. var
  115.    c: char;
  116.    o: byte;
  117.    err: boolean;
  118.  
  119. begin
  120.    o := port[ port_base+LSR ];
  121.    io_delay;
  122.  
  123.    err := false;
  124.    if (o and LSR_OERR) <> 0 then begin inc(LOERR_count);  err := true; end;
  125.    if (o and LSR_PERR) <> 0 then begin inc(LPERR_count);  err := true; end;
  126.    if (o and LSR_FERR) <> 0 then begin inc(LFERR_count);  err := true; end;
  127.    if (o and LSR_BREAK)<> 0 then begin inc(LBREAK_count); err := true; end;
  128.  
  129.    if err then
  130.    begin
  131.       o := port[ port_base+RBR ];
  132.       exit;
  133.    end;
  134.  
  135.    if ((o and LSR_DAV) = 0) then
  136.       exit;
  137.  
  138.    c := chr( port[ port_base+RBR ] ); io_delay;
  139.  
  140.    if XOFF_active then           (* XOFF cancelled by any character *)
  141.       cancel_xoff
  142.    else
  143.  
  144.    if c = XOFF_char then         (* process XOFF/XON flow control *)
  145.       XOFF_active := true
  146.    else
  147.  
  148.    if (c = ^K) then              (* process cancel-output command *)
  149.       control_k
  150.    else
  151.  
  152.    if c = carrier_lost then      (* ignore this special character! *)
  153.    begin
  154.       {do nothing}
  155.    end
  156.    else
  157.  
  158.    if rxque.count < sizeof(rxque.data) then
  159.    begin
  160.       inc(rxque.count);
  161.       rxque.data[rxque.next_in] := c;
  162.       if rxque.next_in < sizeof(rxque.data) then
  163.          inc(rxque.next_in)
  164.       else
  165.          rxque.next_in := 1;
  166.    end;
  167. end;
  168.  
  169.  
  170. (* ------------------------------------------------------------ *)
  171. procedure INTR_poll_transmit;
  172.    (* recover from CTS or XOF handshake when needed *)
  173. begin
  174.    {no action if nothing to transmit}
  175.    if (txque.count = 0) or (com_chan = 0) then
  176.       exit;
  177.  
  178.    {check for XON if output suspended by XOFF}
  179.    disable_int;
  180.    INTR_service_receive;
  181.    INTR_service_transmit;
  182.    enable_int;
  183. end;
  184.  
  185.  
  186. (* ------------------------------------------------------------ *)
  187. procedure cancel_xoff;
  188. begin
  189.    XOFF_active := false;
  190.    INTR_poll_transmit;
  191. end;
  192.  
  193.  
  194. (* ------------------------------------------------------------ *)
  195. procedure INTR_check_interrupts;
  196.    (* check for and process any pending 8250 interrupts.
  197.       can be called from TPAS *)
  198. var
  199.    status:  integer;
  200.  
  201. begin
  202.  
  203. (* get the interrupt identification register *)
  204.    status := port[ port_base+IIR ]; io_delay;
  205.  
  206. (* repeatedly service interrupts until no more services possible *)
  207.    while (status and IIR_PENDING) = 0 do
  208.    begin
  209.       {disable_int;}
  210.  
  211.       case (status and IIR_MASK) of
  212.          IIR_MSR:   (* modem status change interrupt *)
  213.             INTR_service_MSR;
  214.  
  215.          IIR_THRE:  (* transmit holding register empty interrupt *)
  216.             INTR_service_transmit;
  217.  
  218.          IIR_DAV:   (* data available interrupt *)
  219.             INTR_service_receive;
  220.  
  221.          IIR_LSR:   (* line status change interrupt *)
  222.             INTR_service_MSR;
  223.       end;
  224.  
  225.       {enable_int;}
  226.  
  227.   (* get the interrupt identification register again *)
  228.       status := port[ port_base+IIR ];
  229.       io_delay;
  230.    end;
  231.  
  232. end;
  233.  
  234.  
  235. (* ------------------------------------------------------------ *)
  236. procedure INTR_interrupt_handler(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: word);
  237. interrupt;
  238.    (* low-level interrupt service routine.  this procedure processes
  239.       all receive-ready and transmit-ready interrupts from the 8250 chip.
  240.       DO NOT call this proc from TPAS *)
  241.  
  242. begin
  243.  
  244. (* service interrupts until no more services possible *)
  245.    INTR_check_interrupts;
  246.  
  247. (* acknowledge the interrupt and return to foreground operation *)
  248.    port[ $20 ] := $20;   {non-specific EOI} io_delay;
  249.  
  250. end;
  251.  
  252.  
  253. (* ------------------------------------------------------------ *)
  254. function INTR_receive_ready: boolean;
  255.    (* see if any receive data is ready on the active com port *)
  256. begin
  257.    INTR_poll_transmit;
  258.    INTR_receive_ready := rxque.count > 0;
  259. end;
  260.  
  261.  
  262. (* ------------------------------------------------------------ *)
  263. procedure INTR_flush_com;
  264.    (* wait for all pending transmit data to be sent *)
  265. begin
  266.    enable_int;
  267.    while txque.count > 0 do
  268.    begin
  269.       INTR_poll_transmit;
  270.       give_up_time;             (* give up extra time *)
  271.    end;
  272. end;
  273.  
  274.  
  275. (* ------------------------------------------------------------ *)
  276. procedure verify_txque_space;
  277.    (* wait until there is enough space in the queue for this message *)
  278.    (* or until flow control is released *)
  279. begin
  280.    while txque.count > queue_low_water do
  281.    begin
  282.       INTR_poll_transmit;
  283.       give_up_time;             (* give up extra time *)
  284.    end;
  285. end;
  286.  
  287.  
  288. (* ------------------------------------------------------------ *)
  289. procedure INTR_lower_dtr;
  290.    (* lower DTR to inhibit modem answering *)
  291. var
  292.    o: byte;
  293. begin
  294.    if (com_chan = 0) then exit;
  295.  
  296.    o := port [ port_base+MCR ];                 io_delay;
  297.    port[ port_base+MCR ] := o and not MCR_DTR;  io_delay;
  298. end;
  299.  
  300.  
  301. (* ------------------------------------------------------------ *)
  302. procedure INTR_raise_dtr;
  303.    (* raise DTR to allow modem answering - not supported by BIOS *)
  304. var
  305.    o: byte;
  306. begin
  307.    if com_chan = 0 then exit;
  308.  
  309.    o := port [ port_base+MCR ];                       io_delay;
  310.    port[ port_base+MCR ] := o or (MCR_DTR+MCR_RTS);   io_delay;
  311. end;
  312.  
  313.  
  314. (* ------------------------------------------------------------ *)
  315. procedure INTR_select_port;
  316.    (* lookup the port address for the specified com channel *)
  317. begin
  318.    xmit_active := false;
  319.    XOFF_active := false;
  320.  
  321.    if (com_chan > 0) and (com_chan <= MAX_COMn) then
  322.    begin
  323.       port_base := atow(GetEnv('COMBASE'));
  324.       if port_base = 0 then
  325.          port_base := COM_BASE_TABLE[com_chan];
  326.     { bios_bastab[chan] := port_base; }
  327.  
  328.       port_irq := atow(GetEnv('COMIRQ'));
  329.       if port_irq = 0 then
  330.          port_irq := COM_IRQ_TABLE[com_chan];
  331.  
  332.       {force local operation if invalid port specified}
  333.       if (port_base = 0) or (port_irq = 0) then
  334.          com_chan := 0;
  335.  
  336.       port_intr := IRQ_VECT_TABLE[port_irq];
  337.       intr_mask := IRQ_MASK_TABLE[port_irq];
  338.    end;
  339.  
  340. (**
  341. writeln('[chan=',chan,' port base=',port_base,' intr=',port_intr,' mask=',intr_mask,']');
  342. **)
  343.  
  344. (* initialize the receive and transmit queues *)
  345.    rxque.next_in := 1;
  346.    rxque.next_out := 1;
  347.    rxque.count := 0;
  348.  
  349.    txque.next_in := 1;
  350.    txque.next_out := 1;
  351.    txque.count := 0;
  352.  
  353.    INTR_raise_dtr;
  354. end;
  355.  
  356.  
  357. (* ------------------------------------------------------------ *)
  358. procedure INTR_init_com;
  359.    (* initialize communication handlers for operation with the specified
  360.       com port number.  must be called before any other services here *)
  361. var
  362.    o: byte;
  363. begin
  364.  
  365. (* initialize port numbers, receive and transmit queues *)
  366.    INTR_select_port;
  367.  
  368.    if com_chan = 0 then exit;
  369.  
  370. (* save the old interrupt handler's vector *)
  371.    GetIntVec(port_intr, old_vector);
  372. {writeln('got old');}
  373.  
  374. (* install a vector to the new handler *)
  375.    SetIntVec(port_intr,@INTR_interrupt_handler);
  376. {writeln('new set');}
  377.  
  378. (* save original 8250 registers *)
  379.    disable_int;
  380.    prev_LCR := port[ port_base+LCR ];              io_delay;
  381.    prev_MCR := port[ port_base+MCR ];              io_delay;
  382.    prev_IER := port[ port_base+IER ];              io_delay;
  383.    prev_ICTL  := port[ ICTL ];                     io_delay;
  384.  
  385. (* detect 16550 and enable buffering if needed *)
  386.    port[ port_base+FCR ] := FCR_ENABLE_FIFO;       io_delay;
  387.    uart_type := port[ port_base+FCR ];             io_delay;
  388.  
  389. (* clear divisor latch if needed *)
  390.    port[ port_base+LCR ] := prev_LCR and not LCR_ABDL;
  391.    io_delay;
  392.  
  393. (* initialize the 8250 for interrupts *)
  394.    o := port[ port_base+MCR ];                     io_delay;
  395.    port[ port_base+MCR ] := o or MCR_OUT2;         io_delay;
  396.    port[ port_base+IER ] := IER_DAV+IER_THRE;      io_delay;
  397.  
  398. (* enable the interrupt through the interrupt controller *)
  399.    o := port[ ICTL ];                              io_delay;
  400.    port[ ICTL ] := o and (not intr_mask);          io_delay;
  401.    enable_int;
  402.  
  403. (* initialize the receive queues in case of an initial garbage byte *)
  404.    disable_int;
  405.    rxque.next_in := 1;
  406.    rxque.next_out := 1;
  407.    rxque.count := 0;
  408.    enable_int;
  409.  
  410. {writeln('init done');}
  411.  
  412. end;
  413.  
  414.  
  415. (* ------------------------------------------------------------ *)
  416. procedure INTR_uninit_com;
  417.    (* remove interrupt handlers for the com port
  418.       must be called before exit to system *)
  419. var
  420.    o: byte;
  421. begin
  422.    if (port_base = -1) or (old_vector = nil) then
  423.       exit;
  424.  
  425. (* wait for the pending data to flush from the queue *)
  426.    INTR_flush_com;
  427.  
  428. (* attach the old handler to the interrupt vector *)
  429.    disable_int;
  430.  
  431.    SetIntVec(port_intr, old_vector);
  432.  
  433.    port[ port_base+LCR ] := prev_LCR;     io_delay;
  434.    port[ port_base+MCR ] := prev_MCR;     io_delay;
  435.    port[ port_base+IER ] := prev_IER;     io_delay;
  436.    o := port[ ICTL ];                     io_delay;
  437.    port[ ICTL ] := (o and not intr_mask) or (prev_ICTL and intr_mask);
  438.    io_delay;
  439.  
  440. (* disable 16550 FIFO if enabled *)
  441.    port[ port_base+FCR ] := FCR_DISABLE_FIFO;     io_delay;
  442.    enable_int;
  443.  
  444. (***
  445. writeln('prev: LCR=',itoh(prev_LCR),
  446.              ' MCR=',itoh(prev_MCR),
  447.              ' IER=',itoh(prev_IER),
  448.              ' ICTL=',itoh(prev_ICTL));
  449. ****)
  450. (***
  451. writeln(' now: LCR=',itoh(port[ port_base+LCR ]),
  452.              ' MCR=',itoh(port[ port_base+MCR ]),
  453.              ' IER=',itoh(port[ port_base+IER ]),
  454.              ' ICTL=',itoh(port[ ICTL ]));
  455. ****)
  456. (***
  457. writeln('intr_mask=',itoh(intr_mask),
  458.              ' vector=',itoh(seg(old_vector)),':',itoh(ofs(old_vector)));
  459. ***)
  460.  
  461.    old_vector := nil;
  462. end;
  463.  
  464.  
  465. (* ------------------------------------------------------------ *)
  466. procedure INTR_set_baud_rate(speed: word);
  467. var
  468.    divisor: word;
  469.    o: byte;
  470. begin
  471.    if com_chan = 0 then exit;
  472.  
  473. {$IFDEF IN_CINPUT}
  474.    INTR_flush_com;
  475. {$ELSE}
  476.    {INTR_}flush_com;
  477. {$ENDIF}
  478.  
  479.    divisor := 115200 div speed;
  480.    disable_int;
  481.  
  482. (* enable address divisor latch *)
  483.    o := port[port_base+LCR];              io_delay;
  484.    port [port_base+LCR] := o or LCR_ABDL; io_delay;
  485.  
  486. (* set the divisor *)
  487.    portw[port_base+THR] := divisor;       io_delay;
  488.  
  489. (* set 8 bits, 1 stop, no parity, no break, disable divisor latch *)
  490.    prev_LCR := LCR_8BITS   or LCR_1STOP   or
  491.                LCR_NPARITY or LCR_NOBREAK;
  492.  
  493.    port[ port_base+LCR ] := prev_LCR;     io_delay;
  494.  
  495.    enable_int;
  496.  
  497. (****
  498. if setdebug then
  499. writeln(dbfd,'set baud: LCR=',itoh(port[ port_base+LCR ]),
  500.              ' MCR=',itoh(port[ port_base+MCR ]),
  501.              ' IER=',itoh(port[ port_base+IER ]),
  502.              ' ICTL=',itoh(port[ ICTL ]),
  503.              ' div=',divisor,
  504.              ' spd=',speed);
  505. ****)
  506. end;
  507.  
  508.  
  509. (* ------------------------------------------------------------ *)
  510. function INTR_receive_data:  char;
  511.    (* wait for and return 1 character from the active com port *)
  512.    (* returns carrier_lost if carrier is not present *)
  513. var
  514.    c: char;
  515.  
  516. begin
  517.    if com_chan = 0 then exit;
  518.  
  519.    repeat
  520.       io_delay;
  521.  
  522.       if INTR_receive_ready then
  523.       begin
  524.          disable_int;
  525.  
  526.          {deque from rxque}
  527.          c := rxque.data[rxque.next_out];
  528.          if rxque.next_out < sizeof(rxque.data) then
  529.             inc(rxque.next_out)
  530.          else
  531.             rxque.next_out := 1;
  532.          dec(rxque.count);
  533.  
  534.          enable_int;
  535.  
  536.          {strip parity in 7,E mode}
  537.          if even_parity then
  538.             c := chr( ord(c) and $7f );
  539.  
  540.          INTR_receive_data := c;
  541.          exit;
  542.       end;
  543.  
  544.       {give up time while waiting}
  545.       give_up_time;
  546.  
  547.       io_delay;
  548.    until not ((port[port_base+MSR] and MSR_RLSD)<>0);
  549.  
  550.    {carrier not present}
  551.    cancel_xoff;
  552.    INTR_receive_data := carrier_lost;
  553. end;
  554.  
  555.  
  556. (* ------------------------------------------------------------ *)
  557. procedure INTR_transmit_data(s:    longstring);
  558.    (* transmits a string of characters to the specified com port;
  559.       does not transmit when carrier is not present *)
  560. var
  561.    i:    integer;
  562.  
  563. begin
  564.    if com_chan = 0 then exit;
  565.  
  566. (* wait until there is enough space in the queue for this message *)
  567. (* or until flow control is released *)
  568.  
  569.    if txque.count > queue_high_water then
  570.       verify_txque_space;
  571.  
  572.  
  573. (* enque the string to be transmitted *)
  574.    for i := 1 to length(s) do
  575.    begin
  576.       disable_int;
  577.  
  578.       inc(txque.count);
  579.       txque.data[txque.next_in] := s[i];
  580.       if txque.next_in < sizeof(txque.data) then
  581.          inc(txque.next_in)
  582.       else
  583.          txque.next_in := 1;
  584.  
  585.       enable_int;
  586.    end;
  587.  
  588.  
  589. (* force an initial interrupt to get things rolling (in case there are
  590.    no more pending transmit-ready interrupts *)
  591.  
  592.    INTR_poll_transmit;
  593. end;
  594.  
  595. { $R+,S+}
  596.  
  597.